perm filename RHYTH.F4[NEW,LCS]12 blob
sn#309804 filedate 1977-10-09 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 C***** SUBRS RHYTH, SETUP, MARKS, DOTS ********
C00028 ENDMK
C⊗;
C***** SUBRS RHYTH, SETUP, MARKS, DOTS ********
SUBROUTINE RHYTH
COMMON/RINP/R(10,80),POSNT(0/99)
COMMON/RMOD/RMODE2,SET4,IBEAM,NOSET,STEM,STUP,NTC,
1 PS2,RA,RDD,ITB,POSB /PTR/KWDS(250),ITEM,NL,NO,IX
COMMON/DPY/ST(4000),WDS(250),MEDIT,GO /XRN/RN(2000)
1 /SCM/V(78),I,LCNT,STAFF,LIST(200),REND
COMMON /SCX/RHY(4),JALPHA(30),JX,JXX,JZ,IRHY,JD,KA,KB,IZ
COMMON /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,
1 NFLG,IXX,ISEMI,IQT,VX(50),IAMP,K,KN,M,MODE,IBLA
COMMON/ALF/INP(59),NX,NOTE,JSET,KZ,KX,AVGPOS,RLPOS,RLP2,
1 AVP2,ZX,RE,ZZ,RD,RSTX
C SEE ALSO FILLMS, SETLET AND SETUP RE. /FLM/
COMMON /POS/POS1,POS2 /STF/RSTFAC(-3/4),RSTJ2
DIMENSION RPOS(2,100)
EQUIVALENCE (VX(1),X),(VX(2),Y),(VX(7),Z),(RPOS,ST(3400))
1,(VX(3),AB),(VX(4),T),(VX(5),RB),(VX(6),X2)
1,(VX(8),C),(VX(9),S),(VX(10),X3)
DATA FIB/.75/
C FIB IS FOR PSUEDO-FIBONACCI SPACING
RSTJ3=RSTFAC(IFIX(STAFF))
NX=-1
JX=0
Y=0
NOTE=0
ICNTPT=-1
NOSET=0
JSET=0
C STUP IS NEG. IF SETUP IS NOT READY
IF(STUP)GO TO 341
IF(SET4.NE.STAFF)GO TO 70
NOSET=-1
C TO ADD MORE NOTES ON SETUP LINE. WIPES OUT P9 AT END OF SCMSS.
GO TO 270
70 DO 370 K=1,ITEM-IRHY-2
C LOOKS ONLY AT THINGS BEFORE CURRENT INPUT.
J=KWDS(K)
IF(RN(J+1).GT.2)GO TO 370
IF(RN(J+2).EQ.STAFF)GO TO 270
370 CONTINUE
GO TO 170
270 ICNTPT=0
C THIS WILL CAUSE NOTES ADDED TO LINE TO HAVE NO RHYTH VAL IN P9
170 KZ=1
POS2=PS2
C GETS LAST ↑↑ POS. FROM SETUP
JSET=-1
C NEXT NUM.(100) IS LIMIT FOR STF.4 (CAN BE UP TO 300-SEE /FLM/)
DO 9 KX=1,100
9 IF(RPOS(2,KX).GE.0)GO TO 10
10 AVGPOS=RPOS(1,KX)
RLPOS=AVGPOS
344 KX=KX+1
IF(RPOS(2,KX).EQ.-3)GO TO 344
C**** IGNORES CLEFS (BUT NOT BARS) IN AUTOMATIC SPACING ***** 10/76
RLP2=RPOS(1,KX)
343 AVP2=RPOS(2,KX)-.001
IF(AVP2.GT.0)GO TO 341
KX=KX+1
GO TO 343
C AVERAGED AND REAL POSITIONS FROM 'SETUP'
C NEXT FOR NON-SETUP
341 DO 34 K=1,IRHY
Z=ABS(V(K))
CC34 IF(V(K).GT..05)Y=ABS(V(K))+Y
C 88TH NOTES ARE TAKEN AS GRACE NOTES. THEN BECOME 32NDS.
IF(Z.NE.4./88.)GO TO 345
IF(JSET)GO TO 34
C GRACE NOTES SKIPPED IN AUTOMATIC SETUP
Z=.125
C TAKES 1/32 SPACE FOR GRACE NOTE.
CF Y=Y+.125
CF GO TO 34
CF345 Y=ABS(V(K))+Y
345 IF(STUP.LT.-1)Z=Z+(.125-Z)*FIB
C STUP CAN BE SET TO .LT.-1 IN NOTBMS FOR PSUEDO-FIBONACCI SPACE
Y=Y+Z
34 CONTINUE
C Y=TOTAL TIME
CX POZ1=POS1
CX POSNT(0)=POS2
C A SAFEGUARD
C SAVES POS1 FOR POSITIONING MF, CRESC. ETC.
NTC=0
C THE WORD COUNT FOR REAL NOTES.
IF(JSET)GO TO 3421
IF(POS1.LT.POS2)POSX=POS1
C SAVES IT FOR BACKUP
IF(POS1.GE.POS2)POS1=POSX
Z=POS2-POS1
ZX=Z
342 DO 1 K=1,IZ
X=R(1,K)
IF(X.LT.3.)GO TO 1
C JUMP IF NOTE OR REST
IF(X.NE.17.)GO TO 8
C JUMP IF NOT A KEY SIG.
RA=AMOD(R(5,K),100.0)
C 100+KEY SIG NUM = SIG MADE UP OF NATURALS.
RA=2.+ABS(RA)*2.0
GO TO 6
8 IF(X.NE.4.)GO TO 81
C NEXT IS FOR BAR LINES
RA=3
J=K+1
RE=R(1,J)
IF(RE.EQ.3.)RA=1.5
C A CLEF
IF(RE.EQ.18)RA=2.5
C A METER
IF(RE.NE.1)GO TO 83
IF(AMOD(R(5,J),10.).NE.0)RA=4.5
C FINDS ACCI ON NEXT NOTE.
83 IF(K.EQ.IZ)RA=0
C END OF STAFF
GO TO 6
82 RA=5
CGHB82 RA=6
GO TO 83
81 IF(X.EQ.18)GO TO 82
RA=6.
IF(K.LT.3)RA=8.
CGHB RA=7.
C FOR CLEFS
CGHB IF(K.LT.3)RA=9.
C THE FIRST CLEF IS NOT MINI
6 RA=RA*RSTJ3
C SO SPACE WILL DEPEND ON SIZE OF STAFF
Z=Z-RA
R(8,K)=RA
C STORES SPACE NUM THAT MUST BE GIVEN BACK
1 CONTINUE
C SUBTRACTS SPACE FOR CLEF OR BAR. WILL ADD BOTH LATER.
C POS1 AND Z ARE FOR RHYTHMIC SPACING
C SPACE FOR NON-NOTES
134 FORMAT(' **** MISMATCH WITH SPACING STAFF')
3421 K=0
IF(ABS(Y-RA).LE..001)GO TO 3
IF(JSET)TYPE 134
C LOOP TO END
3 K=K+1
C K IS COUNTER
R(7,K)=0
RE=R(1,K)
IF(RE.LE.2.)GO TO 2
RD=R(8,K)
R(8,K)=0
IF(JSET)GO TO 71
7 IF(K.EQ.IZ)POS1=POS2
IF(R(1,K-1).GT.2.)GO TO 73
IF(K.EQ.1)GO TO 73
IF(RE.EQ.4.)GO TO 73
Z=Z+RD/3.
C RETURNS 1/3 OF THE SPACE IF PREV. ITEM IS NOTE OR REST
POS1=POS1-RD/3
C THIS CAN RESULT IN OVERLAP WHICH MUST BE EDITED OUT.!!
73 R(3,K)=POS1
72 POS1=POS1+RD
C ABOVE SECTION LEAVES ROOM FOR CLEF OR BAR
GO TO 337
C 40??? 50???? WHY NOT 100?
71 DO 74 J=KZ,80
74 IF(RE.EQ.-RPOS(2,J))GO TO 75
POS=R(3,K-1)+4
GO TO 76
75 POS=RPOS(1,J)
KZ=J+1
C FOUND SAME TYPE OF ITEM.
76 R(3,K)=POS
GO TO 337
2 JX=JX+1
21 AB=V(JX)
J=9
IF(RE.NE.2)GO TO 121
V(JX)=-AB
C SHOWS RESTS IN AUTO. BEAM SECTION.(ASSUMES REST WAS A + NUMB.)
J=7
121 IF(R(8,K).GE.-1.)R(J,K)=AB
C STORES RHYTH VALUE FOR LATER USE IN PART EXTRACTOR IF NOT CHORD NOTE.
IF(AB.GT..05)GO TO 210
R(3,K)=-1.
CC RA=100
CC T=R(4,K)
CC IF(T)RA=-RA
CC R(4,K)=T+RA
R(4,K)=R(4,K)+100.
C WILL THIS BE OK WITH NOTES BELOW B3 (I.E. NEG POSITIONS.
R(7,K)=1
C FOUND A GRACE NOTE (88TH NOTE)
JZ=1
1211 IF(R(8,K+JZ).GE.0)GO TO 211
J=K+JZ
R(3,J)=-1
C FOR AUTO-SPACING AT 337
R(4,J)=R(4,J)+100.
C MAKE IT A MINI-NOTE
R(8,K)=1000.+ABS(R(4,K)-R(4,J))
C EXTEND THE STEM
JZ=JZ+1
C FOR MORE CHORD NOTES. SHOULD I CHECK FOR END (IZ)?
GO TO 1211
CC211 IF(JZ.GT.1)GO TO 2211
C DON'T CHANGE STEM DIR. IF A CHORD
CC R(8,K)=1000
C 1000 IN P8 PUTS IN SLASH ON TAIL
CC IF(STEM.GE.0)GO TO 2211
CC RA=R(5,K)
CC IF(RA.GE.20)R(5,K)=RA-10.
CC IF(RA.LT.20)R(5,K)=RA+10.
C ** NOT NOW ***TURNS STEM OVER. UNLESS STEM DIRECTIONS WERE FIXED.(SU/SD/)
211 IF(JZ.LE.1)R(8,K)=1000
2211 IF(JSET.GE.0)GO TO 3211
K=K+JZ-1
C POS WILL BE SET AT 336
NTC=NTC+1
C UPDATE THE COUNTER FOR IMPORTANT POSITIONS. POSNT SET AT 336
POSNT(NTC)=-1
GO TO 337
3211 AB=.125
C IT USED TO JUMP. NOW MAKES SPACE FOR GRACE NOTES AS 32NDS.
210 RB=0
CC IF(JSET.GE.0.AND.SET4.LT.0)R(8,K)=-AB-1000.*R(8,K)
C FOR AUTOMATIC SETUP
JZ=K
C JZ WILL BE USED NEAR END
3634 IF(AMOD(AB,.1875).EQ.0)GO TO 122
IF(AMOD(AB*10.,1.5).EQ.0)GO TO 122
C .1875 FINDS SINGLE DOTS ON NOTES (.15 FOR QUINTS) (*10 FOR ROUNDOFF!)
IF(AMOD(AB,.4375).NE.0)GO TO 22
T=20
GO TO 322
122 T=10
322 IF(RE.EQ.2.)GO TO 35
IF(R(6,K).LT.20)GO TO 422
T=T+100
C TO SHIFT DOT DOWN 2 STEPS
CC IF(R(6,K).EQ.30)R(6,K)=0
422 R(7,K)=T
C PUTS ONE OR TWO DOTS
GO TO 36
35 R(6,K)=T/10.
C ADDS DOT TO REST.
36 RB=AB/3.
IF(T.NE.1)RB=(4*AB)/7
C TO KEEP TAIL ON DOTTED NOTE
22 POS=POS1
IF(R(6,K).GE.30)R(6,K)=R(6,K)-30
C 30 NEEDED FOR SOME CASES WITH DOTS ON CHORDS.
IF(JSET.EQ.0)GO TO 220
C NEXT IS FOR SETUP
222 IF(NOTE)GO TO 223
C FIRST TIME A NOTE IS FOUND.
NOTE=-1
POS1=RLPOS
Z=POS2-POS1
C RESETS SPACE AVAILABLE, ZZ IS SPACE FOR NON-NOTES
223 IF(POS1.LT.AVP2)GO TO 221
224 KX=KX+1
C???? OCT, 73 IF(NX.EQ.0)GO TO 225
L=KX
1228 IF(RPOS(2,L).NE.-3)GO TO 228
L=L+1
C IGNORE CLEFS (BUT NOT BARS) ********* 10/76
GO TO 1228
228 IF(NX)RLP2=RPOS(1,L)
NX=-1
225 IF(RPOS(2,KX-1))GO TO 227
RLPOS=RPOS(1,KX-1)
AVGPOS=AVP2
227 AVP2=RPOS(2,KX)-.001
IF(AVP2.GT.0)GO TO 223
C 0 IN RPOS=POS. OF NON-NOTE
CC****** WHY NEEDED?? 6/74 *** IF(RLP2.GE.POS1)NX=0
NX=0
CC*****↑↑↑↑ CHANGED FROM ABOVE *** 6/74
GO TO 224
221 POS=(POS1-AVGPOS)*(RLP2-RLPOS)/(AVP2-AVGPOS)+RLPOS
220 R(3,K)=POS
4634 IF(RE.NE.1)GO TO 44
IF(POS.EQ.POSNT(NTC))GO TO 2634
C SKIPS OTHER CHORD NOTES.
NTC=NTC+1
POSNT(NTC)=POS
C SAVES IT FOR NUMBS ABOVE NOTES, ETC.
2634 IF(AB.GE.2)GO TO 4
IF(AB.EQ.1.333333333)GO TO 4
44 L=K+1
IF(R(8,L).GE.0)GO TO 1634
IF(R(1,L).NE.1.)GO TO 1634
C JUMP IF NOT DOUBLE STOP
C DELETES STEM FROM WHOLE NOTE CHORD (NOW DONE IN NOTWRT IF P7=1)
R(3,L)=R(3,K)
K=L
CC R(8,K)=0
GO TO 3634
C LOOPS BACK TO PICK UP MORE CHORD NOTES
C 'WHITENS' HALF, WHOLE AND TRIPLET HALF NOTES.
4 RA=-R(6,K)
IF(RA.EQ.0)RA=-1
IF(AB.LT.4.)GO TO 144
R(5,K)=AMOD(R(5,K),10.0)
C TAKES STEM INFO OFF WHOLE NOTES -- FOR SLUR ROUTINE.
RP=1
IF(AB.GE.8)RP=2
R(7,K)=R(7,K)+RP
C +1=WHOLE NOTE WILL PRINT +2=DBL WHL NT.
CC NOT NEEDED BECAUSE OF ABOVE. RA=-2.
144 R(6,K)=RA
GO TO 44
1634 T=POS1
RP=AB
IF(STUP.LT.-1)RP=AB+(.125-AB)*FIB
C FOR PSUEDO-FIB. SPACING
POS1=RP/Y*Z+POS1
CF POS1=AB/Y*Z+POS1
CZ GO TO 1636
CZ IF(JSET)GO TO 1636
CZ RP=6.
CZ IF(AMOD(R(5,K+1),10.0).EQ.0)RP=3.
C 3 SPACES IF NO ACCID. ON NEXT NOTE, OTHERWISE 6.
CZ RA=POS1-T
CZ RSTX=RP*RSTJ3
CZ IF(RA.GT.RSTX)GO TO 1636
C JUMP IF NOTES ARE FAR ENOUGH APART
CZ RA=RSTX-RA
C THE DIFFERENCE
CZ Z=Z-Z*RA/(POS2-POS1)
C REDUCES TOTAL SIZE Z
CZ POS1=T+RSTX
1636 T=ABS(R(4,K))
IF(T.LT.500.0.AND.T.GE.80.0)GO TO 337
C LEAVE TAILS ON GRACE NOTES ALONE. (NO SKIP WHEN IN MODE 500)
T=0
RA=AB-RB
IF(RA.EQ.4./6.)GO TO 535
IF(RA.EQ.4./7.)GO TO 535
IF(RA.GT..75)GO TO 535
C KEEPS TAILS OFF TRIPLETS, QUINTS, SEPTS.
DO 534 N=1,4
534 IF(RA.LE.RHY(N))T=N
C DELETES STEM FROM WHOLE NOTES. (NOW DONE IN NOTWRT IF P7=1)
535 IF(R(1,JZ).EQ.1.)GO TO 334
CC R(4,JZ)=0
RA=R(4,JZ)
C SETS REST
IF(R(8,JZ).NE.0.1)GO TO 537
T=-4
R(8,JZ)=-2
C -2 CENTERS THE SIGN UNDER THE RIGHT CONDITIONS
GO TO 536
537 IF(AB.LT.2)GO TO 536
T=-1
IF(AB.GE.4)T=-2
IF(AB.GE.8)T=-3
C -1=HLF RST, -2=WHOLE, -3=DBL WHL RST, -4=REPEAT BAR SIGN(./.)
C WON'T DO DOUBLE DOTTED WHOLE NOTES.
536 R(5,JZ)=T
GO TO 337
C******* 4/74 NEW WAY TO FIND TAILS
C OMITS RESTS (REALLY???)
334 R(7,JZ)=T+R(7,JZ)
337 IF(K.LT.IZ)GO TO 3
M=NTC
DO 335 K=IZ,1,-1
IF(R(3,K).GE.0)GO TO 335
IF(K.NE.IZ)GO TO 336
R(3,K)=POS2-4.
GO TO 335
336 N=K-1
1336 RA=R(3,N)
IF(RA.GT.0)GO TO 2336
N=N-1
IF(N.GT.0)GO TO 1336
C GO BACK (IF MORE GRACE NOTES.) TO FIND PREVIOUS BIG NOTE.
2336 T=R(3,K+1)
RB=T-RA
RA=4
IF(RB.LE.4)RA=RB/3.
C IF SPACE IS SMALL USE 1/3 OF IT.
RB=T-RA
C NEXT FOR GRACE NOTE CHORDS
IF(R(8,K+1).GE.0)GO TO 1335
RB=R(3,K+1)
M=M+1
1335 R(3,K)=RB
POSNT(M)=RB
335 M=M-1
K=0
45 K=K+1
C NEXT IS TO ARRANGE DOTS.
IF(R(7,K).LT.10)GO TO 451
RA=R(3,K)
DO 452 M=K+1,IZ
IF(R(3,M).NE.RA)GO TO 453
C JUMP IF NOT CHORD NOTE.
T=R(7,M)
RB=R(4,M)
IF(T.LT.100.)GO TO 452
C JUMP IF NOTE IS NOT ON LEFT SIDE OF UPWARD STEM
IF(RB-R(4,M-1).NE.2)GO TO 452
IF(AMOD(RB,2.).NE.0)R(7,M)=AMOD(T,10.)
C TAKES AWAY DOT IN CERTAIN CASES TO AVOID CONFUSION.
452 CONTINUE
453 K=M-1
451 IF(K.LT.IZ)GO TO 45
IF(ICNTPT)GO TO 13
DO 113 K=1,IZ
RA=R(1,K)
IF(RA.GT.2)GO TO 113
C THIS ZEROS RHYTH PARAM IF NOTES WERE ALREADY ON THIS LINE.
J=9
IF(RA.EQ.2)J=7
R(J,K)=0
113 CONTINUE
13 N=IZ
NTC=NTC+1
POSNT(NTC)=200
POSNT(0)=0
IF(IREAD)RETURN
DIMENSION ISU(390)
COMMON R2,JH,CENTR,J2,R3,R4,R5,RJQ(17),J3,JQ(19)
1 /POSI/STFF(0/7),JJ2,POSQ /FRMT/FQZ(3),IREAD
EQUIVALENCE (ISU,ST(3600)),(J5,JQ(2))
CALL DPYSET(3,ISU,390)
CALL DPYBRT(6)
J2=STAFF
POSQ=STFF(J2)
J5=1
CC RA=-100
R4=20
C R5=0=1 STANDARD SIZE IS USED.
DO 131 K=1,NTC-1
CC IF(R(1,K).NE.1)GO TO 131
CC IF(R(3,K).EQ.RA)GO TO 131
CC RA=R(3,K)
CC R3=RHORZ(RA)
R3=RHORZ(POSNT(K))
CALL PNUM
C GOES TO DRAW A NUMBER OVER A NOTE
J5=J5+1
IF(J5.EQ.10)J5=0
131 CONTINUE
132 CALL DPYOUT(3)
CALL SETPOG(1)
END
C SETUP ALLOWS YOU TO SET UP RHYTHMS ON STAFF 4 FOR SPACING ALL OTHERS.
SUBROUTINE SETUP
INTEGER PWDS
CCC COMMON/FLM/RPOS(2,300) /ALF/JX,X,RD,RNL,RN6,M,A,RB,RC,
COMMON /ALF/JX,X,RD,RNL,RN6,M,A,RB,RC,
1 INP(64) /SCM/V(78),IV,LCNT,STAFF,LIST(200),REND
COMMON /PTR/PWDS(250),ITEM,L,I,IX
COMMON/DPY/ST(4000),WDS(250),MEDIT,GO /XRN/RN(2000)
COMMON/RMOD/RMODE2,SET4,IBEAM,NOSET,STEM,STUP,NTC,
1 ENDP,RA,RDD,ITB,POSB
DIMENSION RPOS(2,100)
EQUIVALENCE (RPOS,ST(3400))
C RHYTHMIC VALUES ARE SAVED IN P9 OF NOTES AND P7 OF RESTS.
STUP=-1
C THIS SENDS INFO TO SUBR. NOTES
IF(SET4.GT.7)RETURN
C%%%%% IF(SET4.GT.4)RETURN
C **** BE SURE SETUP STAFF HAS SPACE VALUES IN NOTES AND RESTS!!!
IF(ITEM.EQ.0)RETURN
JX=0
CC RNL=0
RA=0
DO 9534 K=1,ITEM
L=PWDS(K)
IF(RN(L+2).NE.SET4)GO TO 9534
RD=RN(L+1)
IF(RD.LT.5)GO TO 5
IF(RD.LT.17)GO TO 9534
5 IF(RD.GT.2)GO TO 6
RC=7
IF(RD.EQ.2)RC=5
IF(RN(L).LT.RC)GO TO 9534
M=9
IF(RD.EQ.2)M=7
IF(RN(L+M).EQ.0)GO TO 9534
C FOR OTHER NOTES ON SPACING STAFF.
IF(RN(L+8).GT.999.)GO TO 9534
C SKIPS MINI-NOTES. BUT TROUBLE IF STEMS CAUSE P8 TO BE ≤ 999.
GO TO 7
C SKIPS 'OTHER' CHORD TONES (I.E. P9=0 IN A NOTE)
6 IF(RD.NE.3)GO TO 8
IF(RN(L).LT.3)GO TO 7
RC=RN(L+5)
IF(RC.GE.100)GO TO 7
IF(RC.GT.3)GO TO 9534
C SKIPS IF NOT A REAL CLEF (+100=MINI CLEF)
GO TO 7
8 IF(RD.NE.4)GO TO 10
IF(RN(L).GT.2)GO TO 9534
C SKIPS IF NOT BARLINE (I.E. ONLY 4 PARAMS)
10 IF(RD.NE.2)GO TO 7
IF(RN(L).LT.5)GO TO 9534
IF(RN(L+7).EQ.0)GO TO 9534
7 JX=JX+1
RPOS(1,JX)=RN(L+3)
IF(RD.GT.2)GO TO 3
C JUMP WHEN TIME VALUES ARE IN P8
RC=RN(L+M)
C FOR VALUES AUTOMATICALLY SET. ALLOWS NON-DUPLE UNITS IN SETUP
277 RA=RA+RC
C SUM OF RHYTHS
GO TO 77
3 RC=-RD
77 RPOS(2,JX)=RC
C RC IS RHYTHMIC VALUE OF NOTE.
9534 CONTINUE
C NEXT PUTS ITEMS IN PROPER ORDER IF THEY WEREN'T ALREADY
C*** 2ND NOTE OF DBL STOP CAN'T!! HAVE RHYTH. VALUE *******
IF(RA.EQ.0)RETURN
C RA=0 MEANS DIDN'T FIND RHYTHMS ON SPACING STAFF.
CALL SORT2(RPOS,JX)
ENDP=200.
IF(RPOS(2,JX))ENDP=RPOS(1,JX)
DO 1 L=1,JX
1 IF(RPOS(2,L).GT.0)GO TO 4
4 RD=RPOS(1,L)
RB=ENDP-RD
C TOTAL SPACE FROM 1ST NOTE TO END OF LINE
RC=RPOS(2,L)
RPOS(2,L)=RD
C REAL AND AVERAGED POSITIONS OF 1ST NOTE ARE THE SAME.
DO 2 K=L+1,JX
RE=RPOS(2,K)
IF(RE)GO TO 2
RD=RC/RA*RB+RD
RC=RE
RPOS(2,K)=RD
2 CONTINUE
C 1,K=REAL POS. 2,K=AVERAGED POS.
C IN RHYTH: POS=(P1-AVG2)*(RL2-RL1)/(AVG2-AVG1)+RL1
JX=JX+1
RPOS(1,JX)=ENDP
RPOS(2,JX)=ENDP
STUP=0
C THIS FOR NOTES AND RHYTH
END
SUBROUTINE MARKS(RA)
COMMON/ALF/INP(72),ML
DIMENSION MKS(14)
DATA MKS/'W','A','F','S','M','T','D','U','H','I','P','C','R','O'/
EQUIVALENCE (MF,MKS(3)),(MH,MKS(9)),(MP,MKS(11)),(MM,MKS(5))
1,(MC,MKS(12)),(MR,MKS(13)),(MI,MKS(10)),(MS,MKS(4))
RA=99
DO 16 JM=1,72
16 IF(INP(JM))GO TO 17
C DIDN'T FIND MORE LETTERS
RETURN
17 N=INP(JM)
ML=INP(JM+1)
M=INP(JM+2)
DO 1 K=1,14
1 IF(N.EQ.MKS(K))GO TO 2
C DID NOT FIND A LETTER
RETURN
C 4=W(EDGE),5=A(CCENT),26=FE(RMATA),7=S(TACCATO),9=T(ENUTO)
C 11=D(OWNBOW), 12=U(PBOW),13=H(ARMONIC),14=PL(US),15=TH(ESIS)
C 16=AR(SIS),17=MO(RDANT)
C 18=I(NVRTD MORD), ---,20=TR(ILL), >39=PPP, PP, CRESC., ETC.
C 21=HW (HEAVY WEDGE), 80=ACC(EL.) FICTA:1=FLAT, 2=#, 3=NAT.
2 GO TO(120,10,12,120,4,11,15,15,15,21,12,80,81,87),K
12 IF(ML.EQ.'L')GO TO 120
C ↑↑↑ PLUS
IF(N.EQ.MF)GO TO 121
RA=42
IF(ML.NE.MP)GO TO 18
RA=41
IF(M.EQ.MP)RA=40
C FOR P, PP, PPP -- 42, 41, 40
GO TO 18
15 IF(ML.EQ.MI)GO TO 82
K=K+1
IF(ML.EQ.MKS(1))K=18
C 'HW' MAKES 21 (EVENTUALLY MAKES CLEF# 44)
120 IF(ML.EQ.MF)GO TO 88
K=K+3
8 RA=K
C YOU CAN TYPE # OR NAME OF MARK
18 DO 6 JM=1,72
N=INP(JM)
INP(JM)=' '
C BLANKS OUT USED LETTERS
IF(N.EQ.'/')RETURN
IF(N.EQ.'*')RETURN
6 IF(N.EQ.';')RETURN
4 IF(ML.EQ.'O')GO TO 20
RA=43
IF(ML.EQ.MF)RA=50
C ↑↑↑↑↑ MP, MF
GO TO 18
121 IF(ML.EQ.'E')GO TO 120
C ↑↑↑ FERMATA
RA=51
IF(ML.EQ.MF)RA=52
IF(ML.EQ.MP)RA=54
IF(M.EQ.MF)RA=53
C F, FF, FFF, FP -- 51, 52, 53, 54 --- SF=45, SFZ=92
IF(ML.NE.MI)GO TO 22
C TYPE FIF, FIS, FIN FOR FICTA flat, sharp, natural
RA=1
JM=JM+1
M=INP(JM+1)
IF(M.EQ.MS)RA=2
IF(M.EQ.'N')RA=3
GO TO 18
22 M=NALF(ML)
IF(M)GO TO 18
IF(M.LE.5)RA=30+M
C TYPE /2 F0/6 F5/ FOR FINGERING NUMS. 0-5
GO TO 18
88 RA=45
C FOR SF AND SFZ
IF(INP(JM+2).EQ.'Z')RA=92
GO TO 18
CC5 K=14
CC GO TO 8
10 IF(ML.EQ.MC)GO TO 84
IF(ML.NE.MR)GO TO 120
19 K=13
C 'R' FOR ARSIS
GO TO 120
11 IF(ML.EQ.MH)K=12
C THESIS
IF(ML.EQ.MR)K=17
GO TO 120
20 K=17
GO TO 8
21 K=18
GO TO 8
80 IF(ML.EQ.'+')GO TO 85
C FOR /N1 C+ N2/ ETC. -- CRESC. AND DECRESC. LINES.
IF(ML.EQ.'-')GO TO 86
RA=70
C CRESC.
GO TO 18
85 RA=200
GO TO 18
86 RA=199
GO TO 18
87 RA=208
GO TO 18
C ↑↑↑ FOR /N1 OT N2/ 8va
81 RA=37
C RIT.
GO TO 18
82 RA=82
C DIM.
GO TO 18
84 RA=80
C ACCEL.
GO TO 18
END
CC NO LONGER CALLED SUBROUTINE DOTS(L,Z,X,RC)
C M=BASIC RHY. NX=NUM OF DOTS
CC COMMON /XRN/RN(4000)
CC RC=4./2.**(Z+2.)
CC IF(RN(L).LT.4)RETURN
CC IF(X.EQ.0)RETURN
C -2=WHOLE, -1=HALF, 0=QUART, 1=EIGHTH, 2=SIXTEENTH, ETC.
CC B=RC
CC DO 100 NN=1,IFIX(X)
CC B=B/2
CC100 RC=RC+B
CC END